Shareware Grab Bag/Shareware Grab Bag.iso/050/madtrb17.arc/TREK_OBJ.P

Text File | 1985-09-08 | 13.0 KB | 375 lines

(*
::::::::::
TREK.OBJ.TEXT
::::::::::
*)

(* overlay *) procedure group(ch:  char);
var
   i: char;

   procedure displaylist; forward;

   procedure useitem;
   label 10;
   var
      x, y, i:  integer;
      j, index, ch: char;

      procedure domachine;
      begin
         case ord(list[index].pts) of
            0:  begin
                for x:= currx - 10 to currx + 10 do
                   for y:= curry + 5 downto curry - 5 do
                      if ok(x,y) then
                         if universe[x,y].ch in ['X','+'] then
                            universe[x,y].strength:= 0;
                addscroll('Hey!  All the klingons have');
                addscroll('lost their power!')
                end;
            1:  begin
                addscroll('All the Klingons are immobilized!');
                nomove:= rand(1,10)
                end;
            2:  begin
                addscroll('Internal explosion in the');
                addscroll('cargo hold!  Systems going');
                addscroll('          down!');
                for i:= 1 to 7 do disable(rand(0,500))
                end;
            3:  begin
                addscroll('Aliens'' cloaking devices');
                addscroll('are not working!');
                seeall:= rand(1,10)
                end;
            4:  begin
                addscroll('The crew cannot understand');
                addscroll('you.  It''s the alien machine,');
                addscroll('         Captain.');
                confuse:= rand(1,10)
                end
            end
      end;

      procedure domach2;
      begin
         case ord(list[index].pts) of
            5:  begin
                for x:= currx - 10 to currx + 10 do
                   for y:= curry + 5 downto curry - 5 do
                      if ok(x,y) then
                         if universe[x,y].ch in ['X','+','R','T','H','A']
                            then universe[x,y].strength:= 0;
                addscroll('Every alien in the area has');
                addscroll('lost their power, Captain.')
                end;
            6:  begin
                addscroll('Short range scanners have');
                addscroll('       burnt out!');
                systems[shortscan]:= rand(0,systems[shortscan])
                end;
            7:  begin
                addscroll('Sir! The engines have shut');
                addscroll('down!  It''s defying all the');
                addscroll('laws of physics, sir!');
                if systems[warp] > 75 then systems[warp]:= 75;
                if systems[impulse] > 75 then systems[impulse]:= 75;
                systems[warp]:= rand(0,systems[warp]);
                systems[impulse]:= rand(0,systems[impulse])
                end;
            8:  begin
                for x:= currx - 10 to currx + 10 do
                   for y:= curry + 5 downto curry - 5 do
                      if ok(x,y) then
                         if universe[x,y].ch in ['X','+','R','T','H','A']
                            then begin
                           if universe[x,y].ch = '+' then nmbrkling:=
                               nmbrkling - 1;
                            if universe[x,y].ch in ['+','R','T','H'] then
                               points:= points + ord(universe[x,y].pts);
                            universe[x,y].ch:= ' ';
                            universe[x,y].strength:= 0
                            end;
                addscroll('Apparently every alien in the');
                addscroll('area has been destroyed, sir.');
                addscroll('A very effective weapon!')
               end;
            9:  begin
                addscroll('Captain! Our torpedos have a');
                addscroll('    much longer range now!');
                longer:= rand(5,15)
                end
            end
      end;

      procedure domach3;
      begin
         case ord(list[index].pts) of
            10:  begin
                 systems[computer]:= 100;
                 addln('Computer ')
                 end;
            11:  begin
                 systems[phasers]:= 100;
                 addln('Phasers ')
                 end;
            12:  begin
                systems[longscan]:= 100;
                 addln('Long-range scanners ')
                 end;
            13:  begin
                 systems[shortscan]:= 100;
                 addln('Short-range scanners ')
                 end;
            14:  begin
                 systems[torpedos]:= 100;
                 addln('Torpedos ')
                 end;
            15:  begin
                 systems[warp]:= 100;
                 addln('Warp-drive engines ')
                 end;
            16:  begin
                 systems[impulse]:= 100;
                 addln('Impulse engies ')
                 end;
            17:  begin
                 nmbrtorps:= nmbrtorps + 10;
                 addscroll('Captain, we''ve got more torpedos!')
                 end;
            18:  begin
                 for x:= currx - 10 to currx + 10 do
                    for y:= curry + 5 downto curry - 5 do
                       if ok(x,y) and ((x > currx + 1) or (x < currx - 1)
                         or (y < curry - 1) or (y > curry + 1)) then
                          if universe[x,y].ch = ' ' then
                             begin
                             universe[x,y].ch:= ',';
                             universe[x,y].strength:= 0;
                             universe[x,y].pts:= chr(1);
                             end;
                 addscroll('Captain, we have apparently been ');
                 addscroll('surrounded by a field of comets.');
                 scroll;
                 addscroll('Also, our warp engines are out.');
                 systems[warp]:= 45
                 end
          end;
          if ord(list[index].pts) < 17 then addscroll('have gone to 100%!');
        end;


      begin
      if currlst < 'a' then
         begin
         addscroll('  There''s nothing to use');
         delay(2000);
         goto 10;
         end;
      displaylist;
      clrmesg;
      mesg(3,'   Which item to use?');
      repeat
         read(kbd,ch);
         if ch in ['A'..'Z'] then ch:= chr(ord(ch) + 32)
      until (ch >= 'a') and (ch <= currlst);
      index:= ch;
      clearscroll;
      case list[index].ch of
        ':':  begin
              addscroll('Power levels coming up, Captain');
              totalpower:= totalpower + rand(500,5000)
              end;
       'M':  begin
              addscroll('   As it is turned on, the');
              addscroll('machine shimmers and disappears.');
              for i:= 1 to 3 do scroll;
              delay(2000);
              addscroll('-------- Machine ----------');
              if ord(list[index].pts) > 9 then domach3
              else if ord(list[index].pts) > 4 then domach2
              else domachine;
              if length(names[ord(list[index].pts)]) = 0 then
                 begin
                 delay(1000);
                 addscroll('Call it:');
                 addln('=>');
                 togglecursor;
                 readln(names[ord(list[index].pts)]);
                 togglecursor;
                 scroll
                 end
              end;
        ')':  begin
              addscroll('Systems are now shielded sir!');
              syshields:= rand(5,20)
              end;
        ']':  begin
              addscroll('Ship has extra protection now sir!');
              allshields:= rand(5,20)
              end;
        '^':  begin
              for x:= currx - 10 to currx + 10 do
                 for y:= curry + 5 downto curry - 5 do
                    if ok(x,y) then
                      if not (universe[x,y].ch in ['%','/','@','B']) then
                          begin
                          if universe[x,y].ch = '+' then nmbrkling:=
                             nmbrkling - 1;
                          if universe[x,y].ch = '#' then nmbrbases:=
                             nmbrbases - 1;
                          if universe[x,y].ch in ['+','R','T','H'] then
                             points:= points + ord(universe[x,y].pts);
                          universe[x,y].ch:= ' ';
                          universe[x,y].strength:= 0
                          end;
              addscroll('Everything is destroyed sir')
              end
        end;
      delay(2000);
      for j:= index to pred(currlst) do
        list[j]:= list[succ(j)];
      currlst:=pred(currlst);
   10: end;

   procedure printitem(item: space);
   begin
      case item.ch of
         ':':  addscroll('Pair of dilithium crystals');
         'M':  begin
               addscroll('An alien machine with strange markings');
               if return then
                   begin
                   addln('   which ');
                   case ord(item.pts) of
                      0:  addscroll('disarms Klingons');
                      1:  addscroll('stops Klingons');
                      2:  addscroll('blows up');
                      3:  addscroll('penetrates a cloaking device');
                      4:  addscroll('causes confusion');
                      5:  addscroll('disarms all aliens');
                      6:  addscroll('destroys short scanners');
                      7:  addscroll('hampers the engines');
                      8:  addscroll('destroys all aliens');
                      9:  addscroll('extends torpedos');
                     10:  addscroll('fixes the computer');
                     11:  addscroll('fixes the phasers');
                     12:  addscroll('fixes the long scanners');
                     13:  addscroll('fixes the short scanners');
                     14:  addscroll('fixes the torpedos');
                     15:  addscroll('fixes the warp drive');
                     16:  addscroll('fixes the impulse engines');
                     17:  addscroll('creates a comet field');
                     18:  addscroll('creates torpedos')
                      end
                   end
               else if length(names[ord(item.pts)]) > 0 then
                   addscroll(concat('  (',names[ord(item.pts)],') '))
               end;
         '^':  addscroll('A super bomb');
         ']':  addscroll('Shields for the ship');
         ')':  addscroll('Shields for systems');
         '/':  addscroll('The Staff of Surak')
         end
   end;

   procedure displaylist;
   var
     i: char;
     temp: string80;
   begin
      clearscroll;
      if currlst < 'a' then addscroll(' You have nothing')
      else begin
          addscroll('--------- Cargo -----------');
          for i:= 'a' to currlst do
             begin
             temp:= ' ) ';
             temp[1]:= i;
             addln(temp);
             printitem(list[i])
             end
         end
   end;

   procedure drop;
   var
      x, y: integer;
      index, i, ch: char;
   begin
      displaylist;
      if currlst >= 'a' then
         begin
         clrmesg;
         mesg(3,'Which item to drop?');
         repeat
            read(kbd,ch);
            if ch in ['A'..'Z'] then ch:= chr(ord(ch) + 32)
         until (ch >= 'a') and (ch <= currlst);
         clearscroll;
         index:= ch;
         x:= currx;
         y:= curry;
         if ok(x,y) then
            begin
            moveround(x,y);
            universe[x,y]:= list[index];
            printitem(list[index])
            end;
         for i:= index to pred(currlst) do
            list[i]:= list[succ(i)];
         currlst:= pred(currlst);
         addscroll('           dropped');
         delay(2000)
         end
   end;

   procedure getitem;
   label 10;
   var
      gotten: boolean;
      x,y: integer;
   begin
     gotten:= false;
     for x:= currx + 1 downto currx - 1 do
       for y:= curry + 1 downto curry - 1 do
         if ok(x,y) then
           if universe[x,y].ch in [':','M','^','/',')',']'] then
             begin
               if currlst < maxlist then
                 begin
                   gotten:= true;
                   currlst:= succ(currlst);
                   list[currlst]:= universe[x,y];
                   universe[x,y].ch:= ' ';
                   universe[x,y].strength:= 0;
                   printitem(list[currlst])
                 end
               else
                 begin
                   if not gotten then addscroll('You cannot carry anymore');
                   goto 10;
                 end
             end;
      if not gotten then addscroll('Nothing to pick up');
10: end;

begin
   return:= false;
   for i:= 'a' to currlst do if list[i].ch = '/' then return:= true;
   case ch of
     'G','g':  getitem;
     'U','u':  useitem;
     'D','d':  drop;
     'W','w':  begin
               displaylist;
               delay(5000)
               end
     end;
   clrmesg
end;